Option Base 1
Dim bigArray&()
Dim NumElements&, ValElement&, ArrSize&
Dim hVBArray%, arraycreated%

Sub cmdMakeArray_Click ()

'this sub redimensions and fills a VB array
'then gets array linear addresses
On Error GoTo OutofMem
If (NumElements& * 4) > 15000000 Then
    MsgBox "The array you requested is more than 15 MB, forget it", 16, "You must have a lot of memory!"
    arraycreated% = 0
    txAnswer = ""
    Exit Sub
ElseIf (NumElements& * 4) > 999999 Then
    user% = MsgBox("This array is between 1 and 15 MB", 65, "Make Big VB Array?")
	If (user% = 2) Then Exit Sub
End If

If (NumElements& < 15999) Then
     ArrSize& = NumElements& + 2
     ArrColumns& = ArrSize&
     ArrayRows& = 1&
     ReDim bigArray&(1 To ArrColumns&, 1 To ArrayRows&)
Else
     ArrayRows& = (NumElements& / 16000&) + 1
     ArrSize& = NumElements& + 2&
     ArrColumns& = 16000&
     ReDim bigArray&(1 To ArrColumns&, 1 To ArrayRows&)
End If
On Error GoTo 0                 'turns off error handling

For Y = 1 To ArrayRows&                     'fills array with value
    For X = 1 To (ArrColumns&)              'if overs 64000 bytes,
    bigArray&(X, Y) = ValElement&           'fills memory in 16,000 byte blocks
    Next X
Next Y

'This is the key code:fixing linear virtual address of VB array

lpVBArray& = VBPTRtoLong(bigArray&(1, 1))   'must get pointer to first element
VBSel% = lpVBArray& \ &H10000               'get selector from pointer
lhvbarray& = GlobalHandle(VBSel%)           'get handle from selector
hVBArray% = VBLowWord(lhvbarray&)           'handle is in the low word
GlobalFix (hVBArray%)                       'fix VB array in virtual space
Win31Linear& = GetSelectorBase(VBSel%)      'Win 3.1 function to get Windows3.1 linear address
UTAddress& = UTSelectorOffSetToLinear(lpVBArray&) 'UT function to get WIn32s linear address from pointer
GlobalUnFix (hVBArray%)                     'must unfix VB Array

'must convert long to equivalent of dword (unsigned long int) and correct for offset of first element from selector start
VBLinearAddress# = CDbl(Win31Linear&)
If (VBLinearAddress# > 0) And ((ArrSize& * 4) > 65534) Then VBLinearAddress# = 9 + VBLinearAddress#   'VB arrays do not start at the selectors
If (VBLinearAddress# > 0) And ((ArrSize& * 4) < 65535) Then VBLinearAddress# = 7 + VBLinearAddress#   'large (huge) arrays are offset an additional
												      'two bytes
If (VBLinearAddress# < 0) And ((ArrSize& * 4) > 65534) Then VBLinearAddress# = 4294967305# + VBLinearAddress#   'same conversion for >2GB virtual addresses
If (VBLinearAddress# < 0) And ((ArrSize& * 4) < 65535) Then VBLinearAddress# = 4294967303# + VBLinearAddress#

VBUTAddress# = CDbl(UTAddress&)
If (VBUTAddress# < 0) Then VBUTAddress# = 4294967296# + VBUTAddress#     'long to unsigned long int (equivalent) conversion for Win32s address


OffSet# = VBUTAddress# - VBLinearAddress#   'compare Win32s address with Win3.1

txVBHandle.Text = Format$(hVBArray%)
txVBLinear.Text = Format$(VBLinearAddress#)
txVBUT.Text = Format$(VBUTAddress#)
txOffset.Text = Format$(OffSet#)
arraycreated% = 1
txAnswer = ""
Leavesub:
Exit Sub

OutofMem:
    If (Err = 7) Then
	MsgBox "Out of memory, reduce size of array", 16, "Array too big"
	arraycreated% = 0
    Else MsgBox "undefined error"
    End If
    Unload frmVBArray
    Resume Leavesub
End Sub

Sub cmdSumArray_Click ()

'summming the array in a win32 function from VB
If arraycreated% = 0 Then
    MsgBox "Redim Array first", 48
    Exit Sub
End If
lpVBArray& = VBPTRtoLong&(bigArray&(1, 1))  'get pointer to first element
VBSel% = lpVBArray& \ &H10000               'get selector from pointer
lhvbarray& = GlobalHandle(VBSel%)
hVBArray% = VBLowWord(lhvbarray&)
bigArray&(1, 1) = NumElements&
GlobalFix (hVBArray%)

'calling 32 bit function through UT
temp& = SumArray32(bigArray&(1, 1))
GlobalUnFix (hVBArray%)

Sum2& = bigArray&(2, 1)
txAnswer.Text = Format$(Sum2&)
End Sub


Sub Form_Load ()
txNumElemts.Text = Format$(10000)
txValElemt.Text = Format$(100)

End Sub

Sub txNumElemts_Change ()
NumElements& = Val(txNumElemts.Text)
If NumElements& < 1 Then
    MsgBox "enter a number >0", 0, "Array size"
    NumElements& = 10000
End If
End Sub

Sub txValElemt_Change ()
ValElement& = Val(txValElemt.Text)
End Sub